JCSM Shareware Collection 1996 September/JCSM Shareware Collection (JCS Distribution) (September 1996).ISO/prgtools/euphor13.zip/SANITY.EX

Text File | 1995-05-16 | 19KB | 927 lines

        ------------------------------------------
        -- AUTOMATIC SELF-CHECKING SANITY TEST  --
        -- for Euphoria                         --
        -- A quick test of most of the features --
        ------------------------------------------
with type_check
with trace
include get.e
include graphics.e
include sort.e
include machine.e
include file.e
include wildcard.e
include image.e

trace(0)

constant msg = 1 -- place to send messages

global object y, i, r

procedure the_end()
    if atom(gets(0)) then
    end if
    if graphics_mode(-1) then
    end if
    abort(1)
end procedure

procedure make_sound()
-- test sound() built-in
    for i = 500 to 5000 by 500 do
    sound(i)
    for j = 1 to 100000 do
    end for
    sound(0)
    end for
end procedure

without warning
procedure abort()
-- force abort with trace back
    puts(msg, "\ndivide by 0 to get trace back...Press Enter\n")
    if sequence(gets(0)) then
    end if
    ? 1/0
end procedure
with warning

procedure show(object x, object y)
-- show the mismatched values
    puts(msg, "\n   ---MISMATCH--- \n   x is ")
    ? x
    puts(msg, "   y is ")
    ? y
    abort()
end procedure

constant epsilon = 1e-10 -- allow for small floating point inaccuracy

procedure same(object x, object y)
-- object x must be identical to object y else abort program
    atom ratio

    if atom(x) and atom(y) then
    if x = y then
        return
    else
        if y = 0 then
        show(x, y)
        else
        ratio = x / y
        if ratio < 1 - epsilon or ratio > 1 + epsilon then
            show(x, y)
        end if
        end if
    end if
    elsif length(x) = length(y) then
    for i = 1 to length(x) do
        same(x[i], y[i])
    end for
    else
    show(x, y)
    end if
end procedure

function abs(atom x)
-- absolute value
    if x < 0 then
    return -x
    else
    return x
    end if
end function

function built_in()
-- built-in tests
    sequence d

    d = date()
    if d[1] < 93 or d[2] > 12 or d[3] < 1 or d[4] > 23 or d[5] > 59 or
    d[6] >59 or d[7] > 7  or d[8] > 366 then
    abort()
    end if
    d = power({-5, -4.5, -1,  0, 1,  2,  3.5, 4, 6},
          { 3,    2, -1,0.5, 0, 29, -2.5, 5, 8})
    if d[1] != -125 or d[2] != 20.25 or d[3] != -1 or d[4] != 0 then
    abort()
    end if
    if d[5] != 1 or d[6] != 536870912 or d[7] <.043 or d[7] > .044 then
    abort()
    end if
    if d[8] != 1024 or d[9] != 1679616 or power(2,3) != 8 then
    abort()
    end if
    same(power(16, 0.5), 4)
    d = remainder({5, 9, 15, -27}, {3, 4, 5, 6})
    if d[1] != 2 or d[2] != 1 or d[3] != 0 or d[4] != -3 then
    abort()
    end if
    d = remainder({11.5, -8.8, 3.5, 5.0}, {2, 3.5, -1.5, -100.0})
    if d[1] != 1.5 or d[2] < -1.81 or d[2] > -1.79 or d[3] != 0.5 or d[4] != 5 then
    abort()
    end if
    same(4, sqrt(16))
    same(3, length("ABC"))
    same({1, 1, 1, 1}, repeat(1, 4))
    if rand(10) > 10 or rand(20) < 1 or not find(rand(5.5), {1,2,3,4,5}) then
    abort()
    end if
    if time() < 0 then
    abort()
    end if
    if abs(sin(3.1415)) > 0.02 then
    abort()
    end if
    if cos(0) < .98 then
    abort()
    end if
    if abs(tan(3.14/4) - 1) > .02 then
    abort()
    end if
    if log(2.7) < 0.8 or log(2.7) > 1.2 then
    abort()
    end if
    if floor(-3.3) != -4 then
    abort()
    end if
    if floor(-999/3.000000001) != -333 then
    abort()
    end if
    if floor(9.99/1) != 9 then
    abort()
    end if
    for i = -9 to 2 do
    if i = 1 then
        return i
    end if
    end for
end function

procedure sub()
    y = 200
end procedure

procedure overflow()
-- test overflows from integer into floating point
    object two29, two30, maxint, prev_i
    integer two30i, mtwo30i
    sequence s

    two30 = 1
    for i = 1 to 30 do
    two30 = two30 * 2
    end for
    s = {two30, two30+1, two30+2}
    s = s + s
    if compare(s, {two30*2, two30*2+2, two30*2+4}) then
    abort()
    end if
    mtwo30i = -1
    for i = 1 to 29 do
    mtwo30i = mtwo30i * 2
    end for
    two30i = 1
    for i = 1 to 29 do
    two30i = two30i * 2
    end for
    if 2 * two30i != -2 * mtwo30i then
    abort()
    end if
    if two30i*2 != two30 then
    abort()
    end if
    two29 = floor(two30 / 2)
    if two29 + two29 != two30 then
       abort()
    end if

    maxint = floor(two30 - 1)
    if maxint + 1 != two30 then
    abort()
    end if

    if 2 + maxint != two30 + 1 then
    abort()
    end if

    if (-maxint - 1) * -1 != two30 then
    abort()
    end if

    prev_i = -maxint + 1
    for i = -maxint to -maxint -5 by -1 do
    if i != prev_i - 1 then
        abort()
    end if
    prev_i = i
    end for

    prev_i = maxint - 5
    for i = maxint - 3 to maxint + 3 by 2 do
    if i != prev_i + 2 then
        abort()
    end if
    prev_i = i
    end for

    if floor(two30) != two30 then
    abort()
    end if

    if floor(two30 + two30 - 1) != two30 * 2 - 1 then
    abort()
    end if
end procedure

type natural(integer x)
    return x >= 0
end type

procedure atomic_ops()
-- test operations on atoms
    object a, x, z
    integer n, m
    natural p

    p = 0
    p = 0.000
    p = 4.0/2.0
    if p != 2.0 then
    abort()
    end if
    n = 1
    m = 1
    if n and m then
    else
    abort()
    end if

    x = 100
    sub() -- y = 200
    z = 300

    if x + y != z then
    abort()
    end if

    if x != 100 then
    abort()
    end if

    if 3 * 3 != 9 or
       3 * 900000000 != 2700000000 or
       15000 * 32000 != 480000000 or
       32000 * 15000 != 480000000 or
       1000 * 13000 != 13000000 or
       13000 * 1000 != 13000000 then
    abort()
    end if
    while x != 100 do
    abort()
    end while

    if not (z - y = 100) then
    abort()
    end if

    if #FFFFFFFF != 4294967295 then
    abort()
    end if

    p = 20
    while not (p < 10) do
    p = p - 2
    end while
    if p != 8 then
    abort()
    end if

    if x * 1000.5 != 100050 or x * y != 20000 or x / y != 0.5 then
    abort()
    end if

    if y < x then
    abort()
    end if

    if y <= x then
    abort()
    end if

    if x > y then
    abort()
    end if

    if x >= y then
    abort()
    end if

    if -x != -100 then
    abort()
    end if

    if x = x and y > z then
    abort()
    end if

    x = 0

    y = {"ten", "one", "two", "three", "four", "five", "six", "seven", "eight",
     "nine", "ten", "ten"}

    while x <= 11 do
    if x = 1 then a = "one"
    elsif x = 2 then a = "two"
    elsif x = 3 then a = "three"
    elsif x = 4 then a = "four"
    elsif x = 5 then a = "five"
    elsif x = 6 then a = "six"
    elsif x = 7 then a = "seven"
             if 1 + 1 = 2 then
                 same(a, "seven")
             elsif 1 + 1 = 3 then
                 abort()
             else
                 abort()
             end if
    elsif x = 8 then a = "eight"
    elsif x = 9 then a = "nine"
    else a = "ten"
    end if
    same(a, y[1+x])
    x = x + 1
    end while

    y = 0
    for xx = 100 to 0 by -2 do
    y = y + xx
    end for
    same(y, 50 * 51)

    for xx = 1 to 10 do
    if xx = 6 then
        x = 6
        exit
    end if
    y = 1
    while y < 25 do
        y = y + 1
        if y = 18 then
        exit
        end if
    end while
    same(y, 18)
    end for
    y = repeat(-99, 7)
    for xx = +3 to -3 by -1 do
    y[xx+4] = xx
    end for
    same(y, {-3, -2, -1, 0, +1, +2, +3})

    y = {1,2,3}
    for xx = 1.5 to +3.0 by .5 do
      y[xx] = xx
    end for
    same(y, {1.5, 2.5, 3.0})
    y = {}
    for xx = -9.0 to -9.5 by -.25 do
      y = y & xx
    end for
    same(y, {-9, -9.25, -9.5})
    y = {}
    for i = 800000000 to 900000000 by 800000000 do
    y = append(y, i)
    end for
    if compare(y, {800000000}) then
    abort()
    end if
    y = 5
    n = 3
    a = 2
    for i = 1 to y by a do
    n = n - 1
    y = 155
    a = 1
    end for
    same(n, 0)
end procedure

procedure floating_pt()
-- test floating-point operations
    sequence x
    atom final

    x = {1.5, -3.5, 1e10, -1e20, 0.0, 0.0001}
    y = repeat(x, 10)
    if x[1]/x[2] > -0.42 or x[1]/x[2] < -0.43 then
    abort()
    end if
    if find(1e10, x) != 3 then
    abort()
    end if
    for a = -1.0 to sqrt(999) by 2.5 do
    if a > 20.0 then
        final = a
        exit
    end if
    end for
    if final < 20.0 or final > 23 then
    abort()
    end if
end procedure

function one()
    return 1
end function

function two()
    return 2.000
end function

function sequence_ops()
-- test operations on sequences
    object i, w, x, y, z
    sequence s
    integer j

    x = "Hello "
    y = "World"

    if find(0, x = x) then
    abort()
    end if
    if x[two()*two() - two()] != 'e' then
    abort()
    end if
    if x[one()+one()] != x[two()] then
    abort()
    end if

    j = x[1]
    if j != 'H' then
    abort()
    end if
    s = {3.0}
    s[1] = 1.0000
    j = s[1]
    if j != 1 then
    abort()
    end if
    i = 1
    if not atom(i) or not integer(i) then
    abort()
    end if
    if length(y) != 5 then
    abort()
    end if
    while i <= 5 do
    x = append(x, y[i])
    i = i + 1
    end while
    i = 1
    while i <= 3 do
    x = append(x, '.')
    x = append(x, '\'')
    i = i + 1
    end while
    same(x, "Hello World.'.'.'")
    x = repeat(5, 19)
    x = append(x, 20)
    x[7] = 9
    y = {9, 9, {9}}
    y = prepend(y, 8)
    y = prepend(y, {9, 9})
    same(y, {{9, 9}, 8, 9, 9, {9}})
    y = x
    z = y * x + x + 1000
    w = z > 1030 or x = 9
    same(z, {1030, 1030, 1030, 1030, 1030, 1030, 1090, 1030, 1030, 1030,
         1030, 1030, 1030, 1030, 1030, 1030, 1030, 1030, 1030, 1420})
    same(w, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
         0, 0, 0, 0, 0, 0, 0, 0, 0, 1})
    x = {100, 200, {1, 2, {0, 0, 0}}, 300}
    x[3][3][3] = 25
    x = x * x
    same(x, {10000, 40000, {1, 4, {0, 0, 625}}, 90000})
    y = x / {1, 2, 3, 4}
    same(y, {10000, 20000, {1/3, 4/3, {0, 0, 625/3}}, 22500})
    -- & tests

    same(2 & {5, 6,7}, {2, 5, 6, 7})
    same({} & 3, {3})
    same("ABC" & "DEF" & "GHIJ" & {}, "ABCDEFGHIJ")
    same('A' & 'B' & 'C', "ABC")

    -- slice tests
    x = "ABCDEFGHIJKLMNOP"
    same(x[1..4], "ABCD")
    y = x[2..5]
    same(y, "BCDE")
    same(x[4..3], {})
    same(x[4..4], "D")
    x[3..5] = "000"
    same(x, "AB000FGHIJKLMNOP")
    x[6..9] = '8'
    same(x, "AB0008888JKLMNOP")

    same(floor({1, 2, -3, 4, -5} / 3), {0, 0, -1, 1, -2})

    return y
end function


procedure sequence_ops2()
-- more tests of sequence operations
object x, y

    x = "ABCDEFGHIJKLMNOP"
    if find('D', x) != 4 then
    abort()
    end if
    if match("EFGH", x) != 5 then
    abort()
    end if
    if match({"AB", "CD"}, {0, 1, 3, {}, {"AB", "C"}, "AB", "CD", "EF"}) != 6 then
    abort()
    end if
    if compare(x,x) != 0 then
    abort()
    end if
    if compare({}, {}) != 0 then
    abort()
    end if
    y = repeat(repeat(repeat(99, 5), 5), 5)
    if y[3][3][3] != 99 then
    abort()
    end if
    if compare(y[4][4][3..5], repeat(99, 3)) != 0 then
    abort()
    end if
    y[3][2][1..4] = 88
    if compare(y[3][2], {88, 88, 88, 88, 99}) != 0 then
    abort()
    end if
end procedure

procedure circularity()
-- test for circular references in internal garbage collector
    object x, y

    x = {{"abc", {0, 0, 0}}, "def", 1, 2}
    x[3] = x
    x[1..2] = x[2..3]
    x = append(x, x)
    x = prepend(x, x)
    if compare(x, x) != 0 then
    abort()
    end if
    y = "ABCDE"
    y[2] = repeat(y, 3)
    if compare(y, y) != 0 then
    abort()
    end if
end procedure

procedure patterns()
-- test wildcard routines
    if wildcard_file("ABC*DEF.*", "XBCDEF.E") then
    abort()
    end if
    if not wildcard_file("A?B?C?D", "a1b2C3D") then
    abort()
    end if
    if wildcard_match("AAA", "AAa") then
    abort()
    end if
    if not wildcard_match("??Z*Z*", "ABZ123Z123") then
    abort()
    end if
end procedure

procedure conversions()
-- test conversion of values to/from string representation
    sequence v

    v = sprintf("values are: %5d, %3d, %4.2f", {1234, -89, 6.22})
    if compare(v, "values are:  1234, -89, 6.22") != 0 then
    abort()
    end if
    v = value("{1,2,3}")
    if compare(v, {GET_SUCCESS, {1,2,3}}) != 0 then
    abort()
    end if
    for x = 1 to 100 by 3 do
    v = value(sprintf("%d", x))
    if compare(v, {GET_SUCCESS, x}) != 0 then
        abort()
    end if
    v = value(sprintf("#%x ", x))
    if compare(v, {GET_SUCCESS, x}) != 0 then
        abort()
    end if
    end for
end procedure

procedure output()
-- test file output routines
    integer file_no

    file_no = open("sanityio.tst", "w")
    if file_no < 0 then
    abort()
    end if
    puts(file_no, "-- io test\n")
    print(file_no, {1,2,3})
    puts(file_no, '\n')
    print(file_no, -99)
    puts(file_no, " {11, {33, {#33}}, 4, 5 }{\t\t}\n")
    puts(file_no, "{} .999 -.999 1.55e00 {11,   22 , {33, 33}, 4, 5  }\n")
    printf(file_no, "%e", 10000)
    printf(file_no, " %d", -123)
    printf(file_no, " %5.1f", 5+1/2)
    printf(file_no, "%50s\n", {"+99 1001 {1,2,3} 1E-4 {1.002e23,-59e-5,"})
    printf(file_no, "%9e}\t\t-1e-20\t   -.00001e5\n", 59e30)
    puts(file_no, "\"Rob\"\"ert\" \"Craig\"  ")
    puts(file_no, "\"\" \"\\n\" \"\\t\\r\"\t")
    puts(file_no, "\"\\'\\\"\" 'A' '\\n' '\\\"' '\\'' '\\r'\n")
    printf(file_no, "{#%x, ", 291)
    puts(file_no, "\"ABC\"} {'A', 'B', '\\n'}")
    close(file_no)
end procedure

procedure input()
-- test file input routines
    integer file_no
    object line
    integer char

    file_no = open("sanityio.tst", "r")
    if file_no < 0 then
    abort()
    end if
    if seek(file_no, 5) then
    abort()
    end if
    if seek(file_no, -1) then
    abort()
    end if
    if seek(file_no, 0) then
    abort()
    end if
    if where(file_no) != 0 then
    abort()
    end if
    line = gets(file_no)
    if compare(line, "-- io test\n") != 0 then
    abort()
    end if
    char = getc(file_no)
    if char != '{' then
    abort()
    end if
    close(file_no)
end procedure

without type_check
integer color
color = 1
sequence v

procedure testgr()
-- test basic VGA graphics operations
    sequence x

    if v[VC_XPIXELS] < 100 or v[VC_YPIXELS] < 100 then
    abort()
    end if
    draw_line(BLUE, {{20, 100}, {600, 100}})
    for i = 1 to 200 by 5 do
    pixel(WHITE, {3*i, i})
    if get_pixel({3*i, i}) != 7 then
        abort()
    end if
    end for
    polygon(color, 0, {{20,350}, {40, 250}, {80, 400}})
    ellipse(color+5, 1, {350, 350}, {440,440})
    color = color + 1
    x = {}
    for i = 0 to 63 do
    x = x & repeat(i, 2)
    end for
    for p = 220 to 320 by 4 do
    display_image({p,p}, repeat(x+color, 2))
    end for
end procedure
with type_check

constant TRUE = 1, FALSE = 0

procedure testget()
-- test input of Euphoria objects
    object gd
    object x, i
    object results

    gd = open("sanityio.tst", "r")
    if gd < 0 or gd > 10 then
    abort()
    end if
    if not sequence(gets(gd)) then
    abort()
    end if
    results = {
     {0, {1,2,3}},
     {0, -99},
     {0, {11, {33, {#33}}, 4, 5}},
     {0, {}},
     {0, {}},
     {0, 0.999},
     {0, -0.999},
     {0, 1.55},
     {0, {11, 22, {33, 33}, 4, 5}},
     {0, 10000},
     {0, -123},
     {0, 5.5},
     {0, 99},
     {0, 1001},
     {0, {1, 2, 3}},
     {0, 0.0001},
     {0, {1.002e+23, -0.00059, 5.9e+31}},
     {0, -1e-20},
     {0, -1},
     {0, "Rob"},
     {0, "ert"},
     {0, "Craig"},
     {0, ""},
     {0, "\n"},
     {0, "\t\r"},
     {0, "\'\""},
     {0, 'A'},
     {0, '\n'},
     {0, '\"'},
     {0, '\''},
     {0, '\r'},
     {0, {#123, "ABC"}},
     {0, {'A', 'B', '\n'}},
     {-#1, 0}
    }
    i = 1
    while TRUE do
    x = get(gd)
    if x[1] = -1 then
        exit
    end if
    same(x, results[i])
    i = i + 1
    end while
    if compare(results[i], {-1, 0}) != 0 then
    puts(2, "wrong number of get values\n")
    end if
    close(gd)
end procedure

function fib(integer n)
-- fibonacci
    if n < 2 then
    return n
    else
    return fib(n-1) + fib(n-2)
    end if
end function

integer rp

procedure recursive_proc()
-- a recursively-called procedure
    if rp > 0 then
    rp = rp - 1
    recursive_proc()
    end if
end procedure

procedure machine_level()
-- quick test of machine-level routines
    atom addr

    addr = allocate(100)
    poke(addr, #C3) -- RET instruction
    if peek(addr) != #C3 then
    abort()
    end if
    call(addr)
    free(addr)
    for x = 0 to +2000000 by 99999 do
    if bytes_to_int(int_to_bytes(x)) != x then
        abort()
    end if
    end for
    if bits_to_int({1,0,1,0}) != 5 then
    abort()
    end if
    if compare(int_to_bits(17,8), {1,0,0,0,1,0,0,0}) != 0 then
    abort()
    end if
end procedure

global type sorted(sequence x)
-- return TRUE if x is in ascending order
    for i = 1 to length(x)-1 do
    if compare(x[i], x[i+1]) > 0 then
        return FALSE
    end if
    end for
    return TRUE
end type

without profile

global procedure sanity()
-- main program
    sequence cmd_line
    integer vga

    vga = not graphics_mode(18)
    v = video_config()
    clear_screen()
    position(12, 20)
    if compare({12, 20}, get_position()) != 0 then
    abort()
    end if
    puts(msg, "Euphoria SANITY TEST ... ")

    for j = 0 to 8 by 2 do
    if atom(getenv("EUDIR")) then
        puts(1, "\nEUDIR environment variable not set - see install.doc\n")
        puts(1, "\nPress Enter to continue...\n")
        the_end()
    end if
    cmd_line = command_line()
    if length(cmd_line) < 1 or length(cmd_line) > 10 then
        abort()
    end if
    if length(current_dir()) < 2 then
        abort()
    end if
    if length(dir(".")) < 2 then
        abort()
    end if
    if vga then
        testgr()
    end if
    make_sound()
    same(built_in(), 1)
    atomic_ops()
    overflow()
    floating_pt()
    if compare(sequence_ops(), "BCDE") != 0 then
        puts(msg, "sequence_ops failed\n")
    end if
    sequence_ops2()
    circularity()
    output()
    input()
    testget()
    conversions()
    patterns()
    system("del sanityio.tst", 2)
    machine_level()
    rp = 100
    recursive_proc()
    if rp != 0 then
        puts(msg, "recursive proc failed\n")
    end if
    if fib(20) != 6765 then
        puts(msg, "fib failed\n")
    end if
    if not sorted(sort(-500 + rand(repeat(1000, 1000)))) then
        puts(msg, "standard sort failed\n")
    end if
    if not sorted(sort({"robert", "junko", "dave", "ken", "lurdes"})) then
        puts(msg, "standard general sort failed\n")
    end if
    end for
    printf(msg, "%s\n", {"PASSED (100%)\n\n  <Enter> to continue"})
    for i = 1 to 200 do
    sound(i*20)
    all_palette(rand(repeat({63,63,63}, v[VC_NCOLORS])))
    end for
    sound(0)
    the_end()
end procedure

integer z

-- another for-loop test
z = 0
for j = 1 to 10 do
    z = z + j
end for
if z != 55 then
    abort()
end if

sanity()